package Log;

use FileHandle;

use MooseX::Singleton;
use Data::Dumper;
use Data::UUID;

use Log::Message::Simple qw[:STD :CARP];

has 'level' => (
    is => 'rw',
    isa => 'Str',
    default => 'FATAL',
    );

has 'uuidgen' => (
    is => 'ro',
    isa => 'Data::UUID',
    default => sub { new Data::UUID; },
    init_arg => undef,
    );

has 'nou' => (
    is => 'ro',
    isa => 'Str',
    default => "00000000-0000-0000-0000-000000000000",
    init_arg => undef,
    );

has 'debuglevel' => (
    is => 'rw',
    isa => 'Int',
    default => 0,
    );

has 'level2int' => (
    is => 'rw',
    isa => 'HashRef',
    default => sub { {
	'NO'   => 0,
	'INTERNAL' => 10,
	'FATAL' => 20,
	'ERROR' => 30,
	'WARNING' => 40,
	'INFO'  => 50,
	'DEBUG' => 60,
	} 
    },
    init_arg => undef,
    );

sub BUILD {
    my $self = shift;
    local $Log::Message::Simple::MSG_FH = \*STDERR;
    local $Log::Message::Simple::ERROR_FH = \*STDERR;
    local $Log::Message::Simple::DEBUG_FH = \*STDERR;
    croak ("log level '".$self->level."' unknown!" )
	unless(defined($self->level2int->{$self->level}))
}

sub setlevels {
    my $self = shift;
    $self->level(shift || 'FATAL');
    $self->debuglevel (shift || 3);
    croak ("setlevel() level '".$self->level."' unknown!" )
	unless(defined($self->level2int->{$self->level}));    
    croak("debuglevel is not numeric") 
	unless($self->debuglevel =~ /^\d+$/o);
    croak("debuglevel is not valid") 
	unless($self->debuglevel >= 0);
}

sub u {
    my $self = shift;
    my $uuid = $self->uuidgen->create();
    return $self->uuidgen->to_string($uuid);
}

sub format {
    my $self = shift;
    my $id = shift;
    my $context = shift;
    return "[$id:$context]\t".join("\t",@_);
}

sub _internal_format {
    my $self = shift;
    return "\t".join("\t",@_)."";
}

sub _levelAllowed {
    my $self = shift;
    my $level = shift;
#    print STDERR 
#	"\n$level(".$self->level2int->{$level}." <= ".
#	$self->level."(".$self->level2int->{$self->level}.")";
    return 
	($self->level2int->{$level}) <= 
	($self->level2int->{$self->level});
}
sub _debugAllowed {
    my $self = shift;
    my $debuglevel = shift;
    return 
	($debuglevel) <= 
	($self->debuglevel);
}

sub xinfo {
    my $self = shift;
    my $level = 'INFO';
    my $uuid = shift;
    my $string = shift;
    my $ret = 0;
    if($self->_levelAllowed($level)) {
	msg($self->_internal_format($uuid,$level,$string),1);
	$ret = 1;
    }
    return $ret;
}
sub xwarning {
    my $self = shift;
    my $level = 'WARNING';
    my $uuid = shift;
    my $string = shift;
    my $ret = 0;
    if($self->_levelAllowed($level)) {
	msg($self->_internal_format($uuid,$level,$string));
#	print STDERR "---------------";
	$ret = 1;
    }
    return $ret;
}

sub xerror {
    my $self = shift;
    my $level = 'ERROR';
    my $uuid = shift;
    my $string = shift;
    my $ret = 0;
    if($self->_levelAllowed($level)) {
	error($self->_internal_format($uuid,$level,$string),0);
	$ret = 1;
    }
    return $ret;
}

sub xsupererror {
    my $self = shift;
    my $level = 'ERROR';
    my $uuid = shift;
    my $string = shift;
    my $ret = 0;
    my $s = $self->_internal_format($uuid,$level,$string);
    if($self->_levelAllowed($level)) {
	error($s);
	$ret = 1;
    }
    $self->_mydie($uuid,$level,$string);
    return $ret;
}

sub _mydie {
    my $self = shift;
    my $uuid = shift;
    my $level = shift;
    my $string = shift;
    my $e = {
	'uuid' => $uuid,
	'level' => $level,
	'string' => $string,
    };
    die $e;
}

sub xfatal {
   my $self = shift;
   my $level = 'FATAL';
   my $uuid = shift;
   my $string = shift;
   my $ret = 0;
   my $s = $self->_internal_format($uuid,$level,$string);
   if($self->_levelAllowed($level)) {
       error($s);
       $ret = 1;
   }
   $self->_mydie($uuid,$level,$string);
   return $ret;
}

sub xinternal {
    my $self = shift;
    my $level = 'INTERNAL';
    my $uuid = shift;
    my $string = shift;
    my $ret = 0;
    my $s = $self->_internal_format($uuid,$level,$string);
    if($self->_levelAllowed($level)) {
	error($s);
	$ret = 1;
    }
    $self->_mydie($uuid,$level,$string);
    return $ret;
}


sub xdebug {
    my $self = shift;
    my $debuglevel = shift;
    my $uuid = shift;
    my $string = shift;
    my $level = 'DEBUG';
    my $ret = 0;
    if($self->_levelAllowed($level)) {
	if($self->_debugAllowed($debuglevel)) {
	    debug($self->_internal_format($uuid,$level.$debuglevel,$string),1);
	    $ret = 1;
	}	
    }
    return $ret;
}

sub xdump {
    my $self = shift;
    my $debuglevel = shift;
    my $dumpinfo = shift;
    my $ref = shift;
    my $level = 'DEBUG';
    my $uuid = $self->nou;
    my $ret = 0;
    if($self->_levelAllowed($level)) {
	if($self->_debugAllowed($debuglevel)) {
	    debug($self->_internal_format($uuid,$level.$debuglevel,$dumpinfo." = ",Dumper($ref)),1);
	    $ret = 1;
	}	
    }
    return $ret;
}

sub get_printable_filtered_stack {
    my @lines = split( /\n/, Log::Message::Simple->stack_as_string() );
    my @out;
    foreach (@lines ) {
	s/^[^\t]*[a-z0-9]+\t//o;
	push(@out,$_);
    }
    Log::Message::Simple->flush();
    return join("\n",@out);
}

sub get_printable_stack {
    return Log::Message::Simple->stack_as_string() ;
}


no Moose;
__PACKAGE__->meta->make_immutable;
